perm filename READX.F4[IRC,LCS] blob sn#641774 filedate 1982-02-15 generic text, type T, neo UTF8
00100		SUBROUTINE READX(N)
00200	C  READS IN TWO FILES FOR TRANSFORMATION
00300		IMPLICIT INTEGER (X-Z)
00400		DIMENSION RN(3)
00500	C  RN WILL HOLD FILE NAMES
00600		COMMON /A/X1(800),Y1(800),Z1(800),K1
00700		COMMON /B/X2(800),Y2(800),Z2(800),K2
00800		COMMON /C/X3(800),Y3(800),Z3(800),K3
00900	1	FORMAT(' TYPE FILE NAME  '$)
01000	2	FORMAT(A5)
01100	3	FORMAT(4I)
01200		WRITE(5,1)
01300		READ(5,2)RN(N)
01400		NUM=1
01500		REWIND NUM
01600		CALL IFILE(NUM,RN(N))
01700		GO TO (10,20),N
01800	C  K1 AND K2 WILL HOLD TOTAL OF POINTS.
01900	10	K1=1
02000	100	READ(NUM,3,END=12)K,X1(K1),Y1(K1),Z1(K1)
02100		K1=K1+1
02200		GO TO 100
02250	12	K1=K1-1
02275		RETURN
02300	20	K2=1
02400	200	READ(NUM,3,END=11)K,X2(K2),Y2(K2),Z2(K2)
02500		K2=K2+1
02600		GO TO 200
02700	11 	K2=K2-1
02750		END
02800	 
02900		SUBROUTINE REVERS
03000	C  REVERSES A AND B DATA. B MUST BE GREATER
03100		COMMON /A/X1(800),Y1(800),Z1(800),K1
03200		COMMON /B/X2(800),Y2(800),Z2(800),K2
03300		COMMON /C/X3(800),Y3(800),Z3(800),K3
03400		DO 1 K=1,K1
03500		X3(K)=X1(K)
03600		Y3(K)=Y1(K)
03700	1	Z3(K)=Z1(K)
03800		K3=K1
03900		DO 27 K=1,K2
04000		X1(K)=X2(K)
04100		Y1(K)=Y2(K)
04200	27	Z1(K)=Z2(K)
04300		K1=K2
04400		DO 3 K=1,K3
04500		X2(K)=X3(K)
04600		Y2(K)=Y3(K)
04700	3	Z2(K)=Z3(K)
04800		K2=K3
04900		END
05000	
05100		SUBROUTINE FINDO(J,JOUT)
05200		DIMENSION J(1)
05300		DO 1 K=2,JOUT
05400	1	IF(J(K).NE.0)GO TO 2
05500	2	JOUT=K-1
05600	C  TOTAL POINTS IN OUTLINE
05700		END
05800	
05900		SUBROUTINE OUTPUT
06000		IMPLICIT INTEGER (X-Z)
06300		COMMON /A/X1(800),Y1(800),Z1(800),K1
06400		COMMON /B/X2(800),Y2(800),Z2(800),K2
06500		COMMON /C/X3(800),Y3(800),Z3(800),K3
06600	1	FORMAT(' TYPE OUTPUT FILE NAME  '$)
06700	2	FORMAT(A5)
06710		TYPE 1
06720		ACCEPT 2,NAM
06730		IF(NAM.NE.'DPY')GO TO 20
06800	3	FORMAT(3I4,I2,3X,3I4,I2,3X,3I4,I2,3X,3I4,I2)
06900		J=K3/4+1
07000		DO 4 K=1,J
07050		L=K+J
07075		M=K+J+J
07087		N=K+J+J+J
07100		TYPE 3,K,X3(K),Y3(K),Z3(K),L,X3(L),Y3(L),Z3(L),
07200		3 M,X3(M),Y3(M),Z3(M),N,X3(N),Y3(N),Z3(N)
07300	4	CONTINUE
07400		PAUSE
07410	20	CALL OFILE(1,NAM)
07420		K1=0
07430		DO 21 K=1,K3
07440		IF(Z3(K).NE.0)GO TO 28
07450	C LOOK FOR REDUNDANT POINTS
07460		J=X3(K)
07470		IF(J.EQ.X3(K+1).AND.J.EQ.X3(K+2))GO TO 21
07480		J=Y3(K)
07490		IF(J.EQ.Y3(K+1).AND.J.EQ.Y3(K+2))GO TO 21
07500	28	K1=K1+1
07510		X1(K1)=X3(K)
07520		Y1(K1)=Y3(K)
07530		Z1(K1)=Z3(K)
07540	21	CONTINUE
07550	22	FORMAT(3I4,I2)
07570		DO 25 K=1,340
07572		IF(K.LT.320)GO TO 25
07574		IF(Z1(K).NE.0)GO TO 200
07580	25	WRITE(1,22)K,X1(K),Y1(K),Z1(K)
07590	200	END FILE 1
07600		NAM=NAM+2
07610	C  BE SURE TO USE 5-LETTER NAME ONLY.
07620		CALL OFILE(1,NAM)
07630		M=0
07632		N=K
07640		DO 23 K=N,K1
07650		M=M+1
07660	23	WRITE(1,22)M,X1(K),Y1(K),Z1(K)
07670		END FILE 1
07680		END